home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / TUT21.ZIP / GFX3.PAS < prev    next >
Pascal/Delphi Source File  |  1995-01-17  |  11KB  |  406 lines
  1. Unit GFX3;
  2.  
  3.  
  4. INTERFACE
  5.  
  6. USES crt;
  7. CONST VGA = $A000;
  8.  
  9. TYPE Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
  10.      VirtPtr = ^Virtual;                  { Pointer to the virtual screen }
  11.  
  12. VAR Virscr : VirtPtr;                     { Our first Virtual screen }
  13.     Vaddr  : word;                        { The segment of our virtual screen}
  14.     Scr_Ofs : Array[0..199] of Word;
  15.  
  16. Procedure SetMCGA;
  17.    { This procedure gets you into 320x200x256 mode. }
  18. Procedure SetText;
  19.    { This procedure returns you to text mode.  }
  20. Procedure Cls (Where:word;Col : Byte);
  21.    { This clears the screen to the specified color }
  22. Procedure SetUpVirtual;
  23.    { This sets up the memory needed for the virtual screen }
  24. Procedure ShutDown;
  25.    { This frees the memory used by the virtual screen }
  26. procedure flip(source,dest:Word);
  27.    { This copies the entire screen at "source" to destination }
  28. Procedure Pal(Col,R,G,B : Byte);
  29.    { This sets the Red, Green and Blue values of a certain color }
  30. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  31.   { This gets the Red, Green and Blue values of a certain color }
  32. procedure WaitRetrace;
  33.    {  This waits for a vertical retrace to reduce snow on the screen }
  34. Procedure Hline (x1,x2,y:word;col:byte;where:word);
  35.    { This draws a horizontal line from x1 to x2 on line y in color col }
  36. Procedure Line(a,b,c,d:integer;col:byte;where:word);
  37.   { This draws a solid line from a,b to c,d in colour col }
  38. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  39.    { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  40.      in color col }
  41. Function rad (theta : real) : real;
  42.    {  This calculates the degrees of an angle }
  43. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
  44.    { This puts a pixel on the screen by writing directly to memory. }
  45. Function Getpixel (X,Y : Integer; where:word) :Byte;
  46.    { This gets the pixel on the screen by reading directly to memory. }
  47. Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  48.   { This loads the cel 'filename' into the pointer scrptr }
  49. Procedure LoadPal (FileName : string);
  50.   { This loads in an Autodesk Animator V1 pallette file }
  51.  
  52. IMPLEMENTATION
  53.  
  54. {──────────────────────────────────────────────────────────────────────────}
  55. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  56. BEGIN
  57.   asm
  58.      mov        ax,0013h
  59.      int        10h
  60.   end;
  61. END;
  62.  
  63. {──────────────────────────────────────────────────────────────────────────}
  64. Procedure SetText;  { This procedure returns you to text mode.  }
  65. BEGIN
  66.   asm
  67.      mov        ax,0003h
  68.      int        10h
  69.   end;
  70. END;
  71.  
  72. {──────────────────────────────────────────────────────────────────────────}
  73. Procedure Cls (Where:word;Col : Byte); assembler;
  74.    { This clears the screen to the specified color }
  75. asm
  76.    push    es
  77.    mov     cx, 32000;
  78.    mov     es,[where]
  79.    xor     di,di
  80.    mov     al,[col]
  81.    mov     ah,al
  82.    rep     stosw
  83.    pop     es
  84. End;
  85.  
  86. {──────────────────────────────────────────────────────────────────────────}
  87. Procedure SetUpVirtual;
  88.    { This sets up the memory needed for the virtual screen }
  89. BEGIN
  90.   GetMem (VirScr,64000);
  91.   vaddr := seg (virscr^);
  92. END;
  93.  
  94. {──────────────────────────────────────────────────────────────────────────}
  95. Procedure ShutDown;
  96.    { This frees the memory used by the virtual screen }
  97. BEGIN
  98.   FreeMem (VirScr,64000);
  99. END;
  100.  
  101. {──────────────────────────────────────────────────────────────────────────}
  102. procedure flip(source,dest:Word); assembler;
  103.   { This copies the entire screen at "source" to destination }
  104. asm
  105.   push    ds
  106.   mov     ax, [Dest]
  107.   mov     es, ax
  108.   mov     ax, [Source]
  109.   mov     ds, ax
  110.   xor     si, si
  111.   xor     di, di
  112.   mov     cx, 32000
  113.   rep     movsw
  114.   pop     ds
  115. end;
  116.  
  117. {──────────────────────────────────────────────────────────────────────────}
  118. Procedure Pal(Col,R,G,B : Byte); assembler;
  119.   { This sets the Red, Green and Blue values of a certain color }
  120. asm
  121.    mov    dx,3c8h
  122.    mov    al,[col]
  123.    out    dx,al
  124.    inc    dx
  125.    mov    al,[r]
  126.    out    dx,al
  127.    mov    al,[g]
  128.    out    dx,al
  129.    mov    al,[b]
  130.    out    dx,al
  131. end;
  132.  
  133. {──────────────────────────────────────────────────────────────────────────}
  134. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  135.   { This gets the Red, Green and Blue values of a certain color }
  136. Var
  137.    rr,gg,bb : Byte;
  138. Begin
  139.    asm
  140.       mov    dx,3c7h
  141.       mov    al,col
  142.       out    dx,al
  143.  
  144.       add    dx,2
  145.  
  146.       in     al,dx
  147.       mov    [rr],al
  148.       in     al,dx
  149.       mov    [gg],al
  150.       in     al,dx
  151.       mov    [bb],al
  152.    end;
  153.    r := rr;
  154.    g := gg;
  155.    b := bb;
  156. end;
  157.  
  158. {──────────────────────────────────────────────────────────────────────────}
  159. procedure WaitRetrace; assembler;
  160.   {  This waits for a vertical retrace to reduce snow on the screen }
  161. label
  162.   l1, l2;
  163. asm
  164.     mov dx,3DAh
  165. l1:
  166.     in al,dx
  167.     and al,08h
  168.     jnz l1
  169. l2:
  170.     in al,dx
  171.     and al,08h
  172.     jz  l2
  173. end;
  174.  
  175. {──────────────────────────────────────────────────────────────────────────}
  176. Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler;
  177.   { This draws a horizontal line from x1 to x2 on line y in color col }
  178. asm
  179.   mov   ax,where
  180.   mov   es,ax
  181.   mov   ax,y
  182.   mov   di,ax
  183.   shl   ax,8
  184.   shl   di,6
  185.   add   di,ax
  186.   add   di,x1
  187.  
  188.   mov   al,col
  189.   mov   ah,al
  190.   mov   cx,x2
  191.   sub   cx,x1
  192.   shr   cx,1
  193.   jnc   @start
  194.   stosb
  195. @Start :
  196.   rep   stosw
  197. end;
  198.  
  199. {──────────────────────────────────────────────────────────────────────────}
  200. Procedure Line(a,b,c,d:integer;col:byte;where:word);
  201.   { This draws a solid line from a,b to c,d in colour col }
  202.   function sgn(a:real):integer;
  203.   begin
  204.        if a>0 then sgn:=+1;
  205.        if a<0 then sgn:=-1;
  206.        if a=0 then sgn:=0;
  207.   end;
  208. var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
  209. begin
  210.      u:= c - a;
  211.      v:= d - b;
  212.      d1x:= SGN(u);
  213.      d1y:= SGN(v);
  214.      d2x:= SGN(u);
  215.      d2y:= 0;
  216.      m:= ABS(u);
  217.      n := ABS(v);
  218.      IF NOT (M>N) then
  219.      BEGIN
  220.           d2x := 0 ;
  221.           d2y := SGN(v);
  222.           m := ABS(v);
  223.           n := ABS(u);
  224.      END;
  225.      s := m shr 1;
  226.      FOR i := 0 TO m DO
  227.      BEGIN
  228.           putpixel(a,b,col,where);
  229.           s := s + n;
  230.           IF not (s<m) THEN
  231.           BEGIN
  232.                s := s - m;
  233.                a:= a + d1x;
  234.                b := b + d1y;
  235.           END
  236.           ELSE
  237.           BEGIN
  238.                a := a + d2x;
  239.                b := b + d2y;
  240.           END;
  241.      end;
  242. END;
  243.  
  244.  
  245. {──────────────────────────────────────────────────────────────────────────}
  246. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  247.   { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  248.     in color col }
  249. var
  250.   x:integer;
  251.   mny,mxy:integer;
  252.   mnx,mxx,yc:integer;
  253.   mul1,div1,
  254.   mul2,div2,
  255.   mul3,div3,
  256.   mul4,div4:integer;
  257.  
  258. begin
  259.   mny:=y1; mxy:=y1;
  260.   if y2<mny then mny:=y2;
  261.   if y2>mxy then mxy:=y2;
  262.   if y3<mny then mny:=y3;
  263.   if y3>mxy then mxy:=y3;    { Choose the min y mny and max y mxy }
  264.   if y4<mny then mny:=y4;
  265.   if y4>mxy then mxy:=y4;
  266.  
  267.   if mny<0 then mny:=0;
  268.   if mxy>199 then mxy:=199;
  269.   if mny>199 then exit;
  270.   if mxy<0 then exit;        { Verticle range checking }
  271.  
  272.   mul1:=x1-x4; div1:=y1-y4;
  273.   mul2:=x2-x1; div2:=y2-y1;
  274.   mul3:=x3-x2; div3:=y3-y2;
  275.   mul4:=x4-x3; div4:=y4-y3;  { Constansts needed for intersection calc }
  276.  
  277.   for yc:=mny to mxy do
  278.     begin
  279.       mnx:=320;
  280.       mxx:=-1;
  281.       if (y4>=yc) or (y1>=yc) then
  282.         if (y4<=yc) or (y1<=yc) then   { Check that yc is between y1 and y4 }
  283.           if not(y4=y1) then
  284.             begin
  285.               x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis }
  286.               if x<mnx then
  287.                 mnx:=x;
  288.               if x>mxx then
  289.                 mxx:=x;       { Set point as start or end of horiz line }
  290.             end;
  291.       if (y1>=yc) or (y2>=yc) then
  292.         if (y1<=yc) or (y2<=yc) then   { Check that yc is between y1 and y2 }
  293.           if not(y1=y2) then
  294.             begin
  295.               x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis }
  296.               if x<mnx then
  297.                 mnx:=x;
  298.               if x>mxx then
  299.                 mxx:=x;       { Set point as start or end of horiz line }
  300.             end;
  301.       if (y2>=yc) or (y3>=yc) then
  302.         if (y2<=yc) or (y3<=yc) then   { Check that yc is between y2 and y3 }
  303.           if not(y2=y3) then
  304.             begin
  305.               x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis }
  306.               if x<mnx then
  307.                 mnx:=x;
  308.               if x>mxx then
  309.                 mxx:=x;       { Set point as start or end of horiz line }
  310.             end;
  311.       if (y3>=yc) or (y4>=yc) then
  312.         if (y3<=yc) or (y4<=yc) then   { Check that yc is between y3 and y4 }
  313.           if not(y3=y4) then
  314.             begin
  315.               x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis }
  316.               if x<mnx then
  317.                 mnx:=x;
  318.               if x>mxx then
  319.                 mxx:=x;       { Set point as start or end of horiz line }
  320.             end;
  321.       if mnx<0 then
  322.         mnx:=0;
  323.       if mxx>319 then
  324.         mxx:=319;          { Range checking on horizontal line }
  325.       if mnx<=mxx then
  326.         hline (mnx,mxx,yc,color,where);   { Draw the horizontal line }
  327.     end;
  328.   end;
  329.  
  330. {──────────────────────────────────────────────────────────────────────────}
  331. Function rad (theta : real) : real;
  332.   {  This calculates the degrees of an angle }
  333. BEGIN
  334.   rad := theta * pi / 180
  335. END;
  336.  
  337. {──────────────────────────────────────────────────────────────────────────}
  338. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
  339.   { This puts a pixel on the screen by writing directly to memory. }
  340. asm
  341.    mov  ax,where
  342.    mov  es,ax
  343.    mov  bx,[y]
  344.    shl  bx,1
  345.    mov  di,word ptr [Scr_Ofs + bx]
  346.    add  di,[x]
  347.    mov  al,[col]
  348.    mov  es:[di],al
  349. end;
  350.  
  351.  
  352. {──────────────────────────────────────────────────────────────────────────}
  353. Function Getpixel (X,Y : Integer; where:word):byte; assembler;
  354.   { This puts a pixel on the screen by writing directly to memory. }
  355. asm
  356.    mov  ax,where
  357.    mov  es,ax
  358.    mov  bx,[y]
  359.    shl  bx,1
  360.    mov  di,word ptr [Scr_Ofs + bx]
  361.    add  di,[x]
  362.    mov  al,es:[di]
  363. end;
  364.  
  365. {──────────────────────────────────────────────────────────────────────────}
  366. Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  367.   { This loads the cel 'filename' into the pointer scrptr }
  368. var
  369.   Fil : file;
  370.   Buf : array [1..1024] of byte;
  371.   BlocksRead, Count : word;
  372. begin
  373.   assign (Fil, FileName);
  374.   reset (Fil, 1);
  375.   BlockRead (Fil, Buf, 800);    { Read and ignore the 800 byte header }
  376.   Count := 0;
  377.   BlocksRead := $FFFF;
  378.   while (not eof (Fil)) and (BlocksRead <> 0) do begin
  379.     BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead);
  380.     Count := Count + 1024;
  381.   end;
  382.   close (Fil);
  383. end;
  384.  
  385.  
  386. procedure LoadPal (FileName : string);
  387. var
  388.   F:file;
  389.   loop1:integer;
  390.   pall:array[0..255,1..3] of byte;
  391. begin
  392.   assign (F, FileName);
  393.   reset (F,1);
  394.   blockread (F, pall,768);
  395.   close (F);
  396.   for loop1 := 0 to 255 do
  397.     Pal(loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);
  398. end;
  399.  
  400.  
  401. VAR Loop1:integer;
  402.  
  403. BEGIN
  404.   For Loop1 := 0 to 199 do
  405.     Scr_Ofs[Loop1] := Loop1 * 320;
  406. END.